home *** CD-ROM | disk | FTP | other *** search
/ LOGIC Apps / Logic-APPLE_II_APPS.iso / mac / LOGIC Apple II 5.25" Library - DOS Part 2 / DOS039.dsk / FAST FOURIER TRANSFORM.bas < prev    next >
BASIC Source File  |  2012-02-16  |  3KB  |  105 lines
  1. 5  HOME : GOSUB 1500
  2. 10  HOME : VTAB 10
  3. 20  HIMEM: 16384
  4. 50  PRINT "LINES 100 THRU 400 ARE RESERVED FOR GENERATING REAL FR(X) AND IMAGINARY FI(N) DISCRETE SAMPLES OF THE FUNCTION TO BE TRANSFORMED"
  5. 60  PRINT "THE NUMBER OF SAMPLES N, MUST BE SOME POWER K, OF 2 E.G. N=16, K=4. A 16 POINT SINE FUNCTION IS CURRENTLY STORED"
  6. 100  DIM FR(17),FI(17)
  7. 110  FOR N = 1 TO 16:T = .375 *(N -1):FR(N) =  EXP( -T) * SIN(T):FI(N) = 0: NEXT N
  8. 120 K = 4:N = 16
  9. 490  VTAB 19
  10. 500  PRINT "DO YOU WANT A LISTING OF THE GENERATED TIME FUNCTION?"
  11. 510  INPUT A$
  12. 520  IF A$ = "NO"  THEN 670
  13. 530  IF A$ < >"YES"  THEN 500
  14. 540 B = FR(1)
  15. 550  FOR Z = 2 TO N
  16. 560  IF  ABS(FR(Z)) >B  THEN B =  ABS(FR(Z))
  17. 580  NEXT Z
  18. 590  HGR2 : HCOLOR= 7
  19. 600  FOR Z = 1 TO N
  20. 610  HPLOT Z *(250/N),90 *(1 -.95 *FR(Z)/B)
  21. 620  NEXT Z
  22. 665  FOR V = 1 TO 4000: NEXT V
  23. 670  TEXT : HOME : VTAB 12
  24. 675  PRINT "  ---FFT CALCULATION IN PROGRESS---"
  25. 710 N = 2 ^K:MR = 0:NN = N -1
  26. 720  FOR M = 1 TO NN:L = N
  27. 730 L = L/2: IF MR +L >NN  THEN 730
  28. 735 MR = MR - INT(MR/L) *L +L: IF MR < = M  THEN 751
  29. 740 TR = FR(M +1):FR(M +1) = FR(MR +1):FR(MR +1) = TR:TI = FI(M +1):FI(M +1) = FI(MR +1):FI(MR +1) = TI: NEXT M
  30. 751 L = 1
  31. 755  IF L > = N  THEN 880
  32. 756 ITEP = 2 *L:EL = 1/L
  33. 760  FOR M = 1 TO L:A = 3.14159265 *(1 -M) *EL:WR =  COS(A):WI =  SIN(A)
  34. 770  FOR I = M TO N  STEP ITEP:J = I +L:TR = WR *FR(J) -WI *FI(J):TI = WR *FI(J) +FR(J):FR(J) = FR(I) -TR:FI(J) = FI(I) -TI:FR(I) = FR(I) +TR:FI(I) = FI(I) +TI
  35. 775  NEXT I,M
  36. 780 L = ITEP: GOTO 755
  37. 880  REM --OUTPUT RESULTS--
  38. 885  HOME : VTAB 10
  39. 890  PRINT "IN WHAT FORM DO YOU WANT THE OUTPUT?"
  40. 900  PRINT "MAGNITUDE SPECTRUM PLOT   (!)"
  41. 910  PRINT "    TABLE OF VALUES       (2)"
  42. 920  INPUT A
  43. 930  IF A = 1  THEN 970
  44. 940  IF A = 2  THEN 1130
  45. 950  PRINT "INCORRECT INPUT (1 0R "": GOTO 890
  46. 960  REM  --OUTPUT MAGNITUDE SPECTRUM PLOT--
  47. 970 B = 0
  48. 975  PRINT "   ---CALCULATIONS IN PROGRESS---"
  49. 980  FOR Z = 1 TO 1 +N/2
  50. 990 X3 =  SQR(FR(Z) ^2 +FI(Z) ^2)
  51. 1000  IF X3 >B  THEN B = X3
  52. 1010  NEXT Z
  53. 1020  FOR Z = 1 TO 1 +N/2
  54. 1025 X = Z
  55. 1030 X3 =  SQR(FR(Z) ^2 +FI(Z) ^2)
  56. 1040 X4 =  INT(35 *X3/B)
  57. 1050 C = 0
  58. 1060  PRINT Z; TAB( 5);"!";
  59. 1070 C = C +1
  60. 1080  IF C <X4  THEN  PRINT "=";: GOTO 1070
  61. 1090  PRINT ""
  62. 1100  NEXT Z
  63. 1110  GOTO 1240
  64. 1115  TEXT 
  65. 1120  REM --OUTPUT TABLE OF VALUES
  66. 1130 U = 1:Z = 1
  67. 1145  TEXT 
  68. 1150  PRINT "HARM"; TAB( 7);"REAL"; TAB( 18);
  69. 1160  PRINT "IMAGINARY"; TAB( 31);"MAGNITUDE"
  70. 1170 X3 =  SQR(FR(U) ^2 +FI(U) ^2)
  71. 1180  PRINT U; TAB( 4);FR(U); TAB( 18);FI(U); TAB( 31);X3
  72. 1190 U = U +1:Z = Z +1
  73. 1210  IF U >1 +N/2  THEN 1240
  74. 1220  GOTO 1170
  75. 1230  REM -TERMINATE?-
  76. 1240  PRINT "DO YOU WANT ANOTHER OUTPUT (YES,NO)"
  77. 1250  INPUT A$
  78. 1260  IF A$ = "YES"  THEN 890
  79. 1270  IF A$ < >"NO"  THEN 1240
  80. 1280  END 
  81. 1290  REM --SCRAMBLER ROUTINE--
  82. 1300 Y = 0:N1 = N
  83. 1310  FOR W = 1 TO L
  84. 1320 N1 = N1/2
  85. 1330  IF N <N1  THEN 1360
  86. 1340 Y = Y +2 ^(W -1)
  87. 1350 X = X -N1
  88. 1360  NEXT W
  89. 1370  RETURN 
  90. 1380  REM - MAGNITUDE X(3) SUBROUTINE--
  91. 1390  GOSUB 1300
  92. 1400 X3 =  SQR(X1(Y) ^2 +X2(Y) ^2)
  93. 1410  RETURN 
  94. 1420  END 
  95. 1500  VTAB 5: PRINT "FAST FOURIER TRANSFORM"
  96. 1510  PRINT : PRINT "AUTHOR UNKNOWN"
  97. 1520  PRINT "DATE: 7-79"
  98. 1530  PRINT : PRINT : PRINT "THIS PROGRAM CALCULATES & PLOTS"
  99. 1540  PRINT "FAST FOURIER TRANSFORMATIONS"
  100. 1550  VTAB 20: PRINT "PRESS ESC TO END"
  101. 1560  PRINT : PRINT "<<PRESS SPACE BAR TO CONTINUE..>>"
  102. 1570  IF  PEEK( -16384) = 27  THEN 1600
  103. 1580  CALL  -756: IF  PEEK( -16384) < >32  THEN 1500
  104. 1590  HOME : POKE  -16368,0: RETURN 
  105. 1600  HOME : END